ETO Development Tools 2/ETO Development Tools 2.iso/Tools - Objects/MacApp/MacApp CD Release/MacApp 2.0.1 (Many Libraries)/Examples/DrawShapes/UDrawShapes.inc1.p

Text File | 1990-10-25 | 75.1 KB | 3,044 lines | [TEXT/MPS ]

{$P}
{[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n+]}
{ UDrawShapes.inc1.p}
{ Copyright © 1985 - 1990 by Apple Computer, Inc.  All rights reserved.}

CONST
    kRainbowArrow        = 140;

    kPaletteWidth        = 41;                            {Width of the palette}

    kMinWidth            = 20;                            {minimum width of new shapes}
    kMinHeight            = 20;                            {minimum height of new shapes}
    { The above two constants define the minimum size a newly-sketched shape
      must become before it is considered a legitimate attempt to draw }

    kStaggerAmount        = 16;                            {Amount to stagger windows by}

    kColorMenuBar        = 131;                            {Menu bar for a color system}
    kNonColorMenuBar    = 132;                            {Menu bar for a black & white system}

    kPickerPrompt        = 256;                            {'STR ' resource for Color Picker}

    cChangeShade        = 1012;                         {Buzz command for "Undo Shade Change"}
    cChangeColor        = 1013;                         {Buzz command for "Undo Color Change"}

VAR
    gPat:                ARRAY [cWhite..cBlack] OF Pattern;

    { prototype shapes for the palette }

    gShapesArray:        ARRAY [1..kShapesInPalette] OF TShape;

    { bounds of each square in palette }
    gChoiceArray:        ARRAY [0..kShapesInPalette] OF Rect;

    gArwBitMap:         BitMap;                         {bitmap used to draw the arrow in palette}

    gClipMargin:        Point;                            {the top & left margins to use when
                                                         displaying shapes in the Clipboard}
    gPasteReplacesSelection: BOOLEAN;                    {Tells whether PASTE should REPLACE the
                                                         existing selection, or instead simply add
                                                         new shapes without replacement. Default:
                                                         FALSE; change its value by using the "More
                                                         Debug" menu, obtainable by typing
                                                         command-D}

    gConstrainDrags:    BOOLEAN;                        {Whether dragging shapes with the mouse
                                                         should be constrained so that nothing
                                                         overlaps the view's borders. Default:
                                                         TRUE; change its value by using the "More
                                                         Debug" menu, obtainable by typing
                                                         command-D}

    gStaggerCount:        INTEGER;                        {For SimpleStagger}

    gRainbowArrow:        CCrsrHandle;

    gShadeMenu:         TShadeMenu;

    gBetterFeedback:    BOOLEAN;                        { TRUE to invoke BetterFeedback routines }

{--------------------------------------------------------------------------------------------------}
    {$S AInit}

PROCEDURE TShapeApplication.IShapeApplication;            {Initialize the application}

    VAR
        r:                    Rect;
        box:                TBox;
        circle:             TCircle;
        hBox:                THeavyBox;
        top:                INTEGER;
        i:                    INTEGER;
        ShadeMenu:            TShadeMenu;

    BEGIN

    IF qNeedsColorQD | gConfiguration.hasColorQD THEN
        gMBarDisplayed := kColorMenuBar
    ELSE
        gMBarDisplayed := kNonColorMenuBar;

    IApplication(kDocType);                             {Generic initialization}

    gPat[cWhite] := White;                                {Fill the global array of patterns}
    gPat[cLtGray] := LtGray;
    gPat[cGray] := Gray;
    gPat[cDkGray] := DkGray;
    gPat[cBlack] := Black;

    { Install our custom pattern menu }
    New(ShadeMenu);
    FailNil(ShadeMenu);
    ShadeMenu.IShadeMenu;
    gShadeMenu := ShadeMenu;

    { Set the standard margins to use in the clipboard }
    SetPt(gClipMargin, 16, 16);

    SetRect(r, 10, 50, 28, 70);                         {Define the prototype shapes}
    New(box);
    FailNil(box);
    box.IBox(r, IDBox);
    gShapesArray[IDBox] := box;

    OffSetRect(r, 0, 40);
    New(circle);
    FailNil(circle);
    circle.ICircle(r, IDCircle);
    gShapesArray[IDCircle] := circle;

    OffSetRect(r, 0, 40);
    New(hBox);
    FailNil(hBox);
    hBox.IHeavyBox(r, IDhBox);
    gShapesArray[IDhBox] := hBox;

    WITH gArwBitMap DO                                    {Define the arrow bitmap to be drawn in the
                                                         palette}
        BEGIN
        rowBytes := 2;
        SetRect(bounds, 0, 0, 16, 16);
        baseAddr := @arrow.data;
        END;

    top := 0;
    FOR i := 0 TO kShapesInPalette DO                    {Define the palette choices}
        BEGIN
        SetRect(r, 0, top, kPaletteWidth - 1, top + kPaletteWidth - 1);
        gChoiceArray[i] := r;
        top := top + kPaletteWidth - 1;
        END;

    gPasteReplacesSelection := FALSE;
    gConstrainDrags := TRUE;
    gStaggerCount := 0;

    IF qNeedsColorQD | gConfiguration.hasColorQD THEN
        BEGIN
        { Unlike GetCursor, GetCCursor makes a copy of the color cursor
          resource.  Therefore, you should make one call to GetCCursor
          and multiple calls to SetCCursor }
        gRainbowArrow := GetCCursor(kRainbowArrow);
        FailNil(gRainbowArrow);
        END;
    gBetterFeedback := kBetterFeedbackDesired;

    IF qTemplateViews & gDeadStripSuppression THEN
        BEGIN
        IF Member(TObject(NIL), TShapeView) THEN;
        IF Member(TObject(NIL), TPalette) THEN;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$IFC qDebug}
{$S ASelCommand}

FUNCTION TShapeApplication.DoCommandKey(ch: CHAR; VAR info: EventInfo): TCommand; OVERRIDE;

{ This illustrates how to have a 'Command-key-only' command, i.e. a command
  which is NOT in a menu, but rather only available when the user types
  the 'command' key and another key concurrently.  In this example, the
  user presses 'Command-D' (the D can be in upper or lower case) to
  request that the special 'more debug' menu be put up (or be taken down
  if it was already up) }

    BEGIN
    IF ((ch = 'D') | (ch = 'd')) THEN
        DoCommandKey := DoMenuCommand(cCmdDTyped)
    ELSE
        DoCommandKey := INHERITED DoCommandKey(ch, info);
    END;
{$ENDC}

{--------------------------------------------------------------------------------------------------}
{$S AOpen}

FUNCTION TShapeApplication.DoMakeDocument(itsCmdNumber: CmdNumber): TDocument;
{ NB: Not used to create the document for a shape view in the Clipboard }

    VAR
        shapeDocument:        TShapeDocument;

    BEGIN
    New(shapeDocument);
    FailNil(shapeDocument);
    shapeDocument.IShapeDocument(kDocType);
    DoMakeDocument := shapeDocument;
    END;

{--------------------------------------------------------------------------------------------------}
{$IFC qDebug}
{$S ASelCommand}

FUNCTION TShapeApplication.DoMenuCommand(aCmdNumber: CmdNumber): TCommand; OVERRIDE;

    BEGIN
    DoMenuCommand := NIL;
    CASE aCmdNumber OF

        cPasteReplacesSelection:
            gPasteReplacesSelection := NOT gPasteReplacesSelection;

        cConstrainDrags:
            gConstrainDrags := NOT gConstrainDrags;

        cCmdDTyped:                                     {Command-D typed by user}
            BEGIN
            IF GetMHandle(mMoreDebug) = NIL THEN        {menu not currrently up--put it up}
                InsertMenu(GetResMenu(mMoreDebug), 0)
            ELSE                                        {menu currently up -- take it down}
                DeleteMenu(mMoreDebug);
            InvalidateMenuBar;                            { Get it redrawn }
            END;

        OTHERWISE
            DoMenuCommand := INHERITED DoMenuCommand(aCmdNumber);
    END;                                                {Case}
    END;
{$ENDC}

{--------------------------------------------------------------------------------------------------}
{$IFC qDebug}
{$S ARes}

PROCEDURE TShapeApplication.DoSetupMenus; OVERRIDE;
{The only menu commands handled here are the following two debugging commands:}

    BEGIN
    INHERITED DoSetupMenus;
    EnableCheck(cPasteReplacesSelection, TRUE, gPasteReplacesSelection);
    EnableCheck(cConstrainDrags, TRUE, gConstrainDrags);
    END;
{$ENDC}

{--------------------------------------------------------------------------------------------------}
{$IFC qDebug}
{$S ADebug}

PROCEDURE TShapeApplication.IdentifySoftware; OVERRIDE;

    BEGIN
    WriteLn('DrawShapes Source date: 6 June 86; Compiled on: ', COMPDATE, ' @ ', COMPTIME);
    INHERITED IdentifySoftware;
    END;
{$ENDC}

{--------------------------------------------------------------------------------------------------}
{$S AClipboard}

FUNCTION TShapeApplication.MakeViewForAlienClipboard: TView; OVERRIDE;
{ Launch a view to represent the data found in the Clipboard at
  application start-up time, or when returning from an excursion
  to Switcher, or when returning from a Desk Accessory }

    VAR
        offset:             LONGINT;
        clipShapeView:        TShapeView;
        clipShapeDoc:        TShapeDocument;
        clipShapes:         ShapesOnClipboard;
        aNewShape:            TShape;
        i:                    INTEGER;
        err:                LONGINT;
        perm:                BOOLEAN;
        fi:                 FailInfo;

    PROCEDURE HdlFailure(error: OSErr; message: LONGINT);

        BEGIN
        Handle(clipShapes) := DisposeIfHandle(clipShapes);

        FreeIfObject(clipShapeDoc);
        clipShapeDoc := NIL;
        END;

    BEGIN
    clipShapes := NIL;

    {Before doing anything else, make sure the scrap contains shapes}
    IF GetScrap(NIL, kShapeClipType, offset) > 0 THEN    {found my kind of data }
        BEGIN
        New(clipShapeDoc);
        FailNil(clipShapeDoc);
        clipShapeDoc.IShapeDocument(kDocType);

        CatchFailures(fi, HdlFailure);
        New(clipShapeView);
        FailNil(clipShapeView);
        clipShapeView.IShapeView(clipShapeDoc, NIL, TRUE);

        clipShapeDoc.fShapeView := clipShapeView;

        clipShapes := ShapesOnClipboard(NewPermHandle(0));
        FailNil(clipShapes);
        FailSpaceIsLow;

        perm := PermAllocation(TRUE);                    {Don't allow GetScrap to use temp space}
        err := GetScrap(Handle(clipShapes), kShapeClipType, offset);
        perm := PermAllocation(perm);                    {Restore perm allocation setting}

  { Only a negative result indicates an error--FailOSErr considers
    any non-zero result an error.}
        IF err < 0 THEN
            FailOSErr(err);

        FOR i := 0 TO clipShapes^^.theNumberOfShapes - 1 DO
            BEGIN
            aNewShape := TShape(gShapesArray[clipShapes^^.theShapes[i].theId].Clone);
            FailNil(aNewShape);
            WITH aNewShape, clipShapes^^.theShapes[i] DO
                BEGIN
                fShade := theShade;
                fColor := theColor;
                fExtentRect := theRect;
                END;
            clipShapeDoc.AddShape(aNewShape);
            END;

        Success(fi);
        Handle(clipShapes) := DisposeIfHandle(clipShapes);

        MakeViewForAlienClipboard := clipShapeView;
        END
    ELSE
        MakeViewForAlienClipboard := INHERITED MakeViewForAlienClipboard;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AOpen}

PROCEDURE TShapeDocument.IShapeDocument(fileType: OSType);

    VAR
        fi:                 FailInfo;

    PROCEDURE HdlNewList(error: OSErr; message: LONGINT);

        BEGIN
        Free;
        END;

    BEGIN
    fShapeView := NIL;
    fPaletteView := NIL;
    fShapeList := NIL;                                    {Just in case IDocument fails}
    IDocument(fileType, kDocType, kUsesDataFork, kUsesRsrcFork, NOT kDataOpen, NOT kRsrcOpen);

    CatchFailures(fi, HdlNewList);                        { In case NewList fails.}
    fShapeList := NewList;
    Success(fi);

    {$IFC qDebug}
    fShapeList.SetEltType('TShape');
    {$ENDC}

    fSavePrintInfo := TRUE;

    fReopening := FALSE;
    fFiltering := FALSE;
    fReplaceCommand := NIL;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TShapeDocument.AddShape(shape: TShape);

    BEGIN
    fShapeList.InsertLast(shape);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TShapeDocument.DeleteShape(shape: TShape);
{ Doesn't work for shape still belonging to a command
  (i.e., not yet committed to the document }

    BEGIN
    fShapeList.Delete(shape);
    FreeIfObject(shape);
    shape := NIL;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AOpen}

PROCEDURE TShapeDocument.DoMakeViews(forPrinting: BOOLEAN);

    VAR
        shapeView:            TShapeView;
        palette:            TPalette;
        aWindow:            TWindow;
        aDocState:            DocState;
        minSize:            Point;
        maxSize:            Point;

    PROCEDURE CreateProceduralShapeView;
        { CreateProceduralShapeView used when creating views procedurally to create the shapes view
        in both printing & non-printing cases }

        BEGIN
        New(shapeView);
        FailNil(shapeView);
        shapeView.IShapeView(SELF, palette, FALSE);

        fShapeView := shapeView;
        END;

    PROCEDURE RestoreWindow;
        { RestoreWindow restores the window & scroller using the settings in the documents fDocState
        field }

        BEGIN
        aDocState := fDocState;
        WITH aDocState.theWindowRect DO
            BEGIN
            aWindow.Resize(right - left, bottom - top, FALSE);
            aWindow.Locate(left, top, FALSE);
            END;
        aWindow.ForceOnScreen;
        WITH aDocState.theScrollPosition DO
            fShapeView.fScroller.ScrollTo(h, v, FALSE);
        END;

    BEGIN
    IF forPrinting THEN
        BEGIN
        IF qTemplateViews THEN
            BEGIN
            shapeView := TShapeView(DoCreateViews(SELF, NIL, kShapeViewRSRCID, gZeroVPt));
            fShapeView := shapeView;
            END
        ELSE
            BEGIN
            palette := NIL;
            CreateProceduralShapeView;
            END;
        END                                             { this is the end of the "forPrinting=TRUE"
                                                         case }
    ELSE
        BEGIN
        IF qTemplateViews THEN
            BEGIN
            aWindow := NewTemplateWindow(kShapeWindowRSRCID, SELF);
            FailNil(aWindow);

            fPaletteView := TPalette(aWindow.FindSubView('PLTT'));
            FailNil(fPaletteView);

            fShapeView := TShapeView(aWindow.FindSubView('SHAP'));
            FailNil(fShapeView);

            fShapeView.fPalette := fPaletteView;
            END
        ELSE
            BEGIN
            New(palette);
            FailNil(palette);

            palette.IPalette(SELF);
            fPaletteView := palette;

            CreateProceduralShapeView;

            aWindow := NewPaletteWindow(kShapeWindowRSRCID, kWantHScrollBar, kWantVScrollBar, SELF,
                                        fShapeView, fPaletteView, kPaletteWidth, kLeftPalette);
            END;

        fShapeView.fScroller := fShapeView.GetScroller(TRUE);

        IF fReopening THEN
            RestoreWindow
        ELSE
            BEGIN
            aWindow.AdaptToScreen;
            aWindow.SimpleStagger(kStaggerAmount, kStaggerAmount, gStaggerCount);
            END;

        { set window's resize limits so it can't become wider than the shapeview's edge }
        WITH aWindow.fResizeLimits DO
            BEGIN
            minSize := topLeft;
            maxSize := botRight;
            END;
        WITH maxSize DO
            h := Min(fShapeView.fSize.h + fPaletteView.fSize.h + kSBarSizeMinus1, h);
        aWindow.SetResizeLimits(minSize, maxSize);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AWriteFile}

PROCEDURE TShapeDocument.DoNeedDiskSpace(VAR dataForkBytes, rsrcForkBytes: LONGINT);

    BEGIN
    { get Print record requirements }
    INHERITED DoNeedDiskSpace(dataForkBytes, rsrcForkBytes);

    dataForkBytes := dataForkBytes + fShapeList.GetSize * SIZEOF(ShapeData);
    rsrcForkBytes := rsrcForkBytes + kRsrcTypeOverhead + kRsrcOverhead + SIZEOF(DocState);
    END;

{
Doc file has the following format:
  Data Fork:
    (a)  kSizePrintInfo (120 bytes) => PrintInfo
    (b)  The rest => The shapes themselves

 Resource Fork:
    (a)  SIZEOF(DocState) => DocState (rsrc type: 'DSTA', number: 1)
}

{--------------------------------------------------------------------------------------------------}
{$S AReadFile}

PROCEDURE TShapeDocument.DoRead(aRefNum: INTEGER; rsrcExists, forPrinting: BOOLEAN);

    VAR
        i:                    INTEGER;
        id:                 INTEGER;
        count:                LONGINT;
        newShape:            TShape;
        docStateHandle:     HDocState;

    BEGIN
    INHERITED DoRead(aRefNum, rsrcExists, forPrinting); {read print info stuff}

    IF rsrcExists THEN
        BEGIN
        docStateHandle := HDocState(GetResource(kDocRsrcKind, kDocStateID));
        IF docStateHandle <> NIL THEN
            BEGIN
            fDocState := docStateHandle^^;
            fReopening := TRUE;
            END;
        END
    ELSE
        BEGIN
        {$IFC qDebug}
        ProgramBreak('Resource fork doesn''t exist for saved file');
        {$ENDC}
        Failure(1                                        {???} , 0);
        END;

    FOR i := 1 TO fDocState.theNumberOfShapes DO
        BEGIN
        count := SIZEOF(INTEGER);
        FailOSErr(FSRead(aRefNum, count, @id));

        IF (id >= 1) & (id <= kShapesInPalette) THEN
            BEGIN
            newShape := TShape(gShapesArray[id].Clone);
            FailNil(newShape);

            newShape.ReadFrom(aRefNum);

            AddShape(newShape);
            END
            {$IFC qDebug}
        ELSE
            WriteLn('Ignored invalid shape ID = ', id: 1, ' shape #: ', i: 1)
            {$ENDC} ;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AWriteFile}

PROCEDURE TShapeDocument.DoWrite(aRefNum: INTEGER; makingCopy: BOOLEAN);

    VAR
        vhs:                VHSelect;
        aDocState:            DocState;
        count:                LONGINT;
        window:             TWindow;
        numberOfShapes:     INTEGER;
        dummyRect:            Rect;
        docStateHandle:     HDocState;
        aWindowRect:        Rect;

{--------------------------------------------------------------------------------------------------}

    PROCEDURE WriteShape(shape: TShape);

        BEGIN
        shape.WriteTo(aRefNum);
        END;

    BEGIN
    INHERITED DoWrite(aRefNum, makingCopy);             {write print info stuff}

    { Call SurveyShapes just to get number of shapes }
    SurveyShapes(FALSE, numberOfShapes, dummyRect);
    window := TWindow(fWindowList.First);

    docStateHandle := HDocState(NewHandle(SIZEOF(DocState)));
    FailNil(docStateHandle);

    window.GetGlobalBounds(aWindowRect);
    docStateHandle^^.theWindowRect := aWindowRect;
    docStateHandle^^.theScrollPosition := fShapeView.fScroller.fTranslation;
    docStateHandle^^.theNumberOfShapes := numberOfShapes;

    AddResource(Handle(docStateHandle), kDocRsrcKind, kDocStateID, 'Doc State');
    FailOSErr(ResError);

    EachVirtualShapeDo(WriteShape);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TShapeDocument.EachShapeDo(PROCEDURE DoThis(shape: TShape));
{ Iterates through the list of shapes. We have a separate method for this
  to hide the actual implementation of the shape list structure. }

    BEGIN
    fShapeList.Each(DoThis);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TShapeDocument.EachPotentialShapeDo(PROCEDURE
                                              DoThis(shape: TShape));
{ Iterates through all the shapes in document plus any 'pastee' shapes
  which may have been added by a not-yet-committed Paste.}

    BEGIN
    EachShapeDo(DoThis);
    IF fReplaceCommand <> NIL THEN
        fReplaceCommand.EachNewShapeDo(DoThis);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TShapeDocument.EachVirtualShapeDo(PROCEDURE
                                            DoThis(shape: TShape));
{ EachVirtualShape iterates through only those shapes that appear
  to be present at the moment to the USER, given the
  UNDO/REDO status of the last command. Thus it iterates
  through some but possibly not all of the shapes in the
  document, and possibly also through not-yet-in-the-document pastees }

{--------------------------------------------------------------------------------------------------}

    PROCEDURE MaybeDoThis(shape: TShape);

        BEGIN
        IF (NOT fFiltering) | (NOT shape.fWasSelected) THEN
            DoThis(shape);
        END;

    BEGIN
    EachShapeDo(MaybeDoThis);
    IF fReplaceCommand <> NIL THEN
        fReplaceCommand.EachNewShapeDo(DoThis);
    END;

{--------------------------------------------------------------------------------------------------}
{$S AFields}

PROCEDURE TShapeDocument.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr;
                                                    fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TShapeDocument', NIL, bClass);
    DoToField('fShapeView', @fShapeView, bObject);
    DoToField('fPaletteView', @fPaletteView, bObject);
    DoToField('fShapeList', @fShapeList, bObject);
    DoToField('fDocState.theNumberOfShapes', @fDocState.theNumberOfShapes, bInteger);
    DoToField('fDocState.theWindowRect', @fDocState.theWindowRect, bRect);
    DoToField('fDocState.theScrollPosition', @fDocState.theScrollPosition, bPoint);
    DoToField('fReopening', @fReopening, bBoolean);
    DoToField('fReplaceCommand', @fReplaceCommand, bObject);
    DoToField('fFiltering', @fFiltering, bBoolean);
    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

FUNCTION TShapeDocument.FirstSelectedShapeThat(FUNCTION
                                               TestSelectedShape(aShape: TShape): BOOLEAN): TShape;

    VAR
        aShape:             TShape;

    FUNCTION TestShape(aShape: TObject): BOOLEAN;

        BEGIN
        IF TShape(aShape).fIsSelected THEN
            TestShape := TestSelectedShape(TShape(aShape))
        ELSE
            TestShape := FALSE;
        END;

    BEGIN
    aShape := TShape(fShapeList.FirstThat(TestShape));
    IF (aShape = NIL) & (fReplaceCommand <> NIL) THEN
        aShape := fReplaceCommand.FirstShapeThat(TestSelectedShape);
    FirstSelectedShapeThat := aShape;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AClose}

PROCEDURE TShapeDocument.Free; OVERRIDE;

    BEGIN
    FreeData;
    FreeIfObject(fShapeList);
    fShapeList := NIL;

    INHERITED Free;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AClose}

PROCEDURE TShapeDocument.FreeData;

    PROCEDURE DoToShape(aShape: TShape);

        BEGIN
        FreeIfObject(aShape);
        END;

    BEGIN
    IF fShapeList <> NIL THEN
        BEGIN
        EachShapeDo(DoToShape);
        fShapeList.DeleteAll;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TShapeDocument.SurveyShapes(selecteesOnly: BOOLEAN; VAR numberOfShapes: INTEGER;
                                      VAR combinedExtent: Rect);

    PROCEDURE UnionizeShapes(shape: TShape);

        BEGIN
        IF shape.fIsSelected | NOT selecteesOnly THEN
            BEGIN
            numberOfShapes := numberOfShapes + 1;
            IF numberOfShapes > 1 THEN
            {$Push} {$h-}
                UnionRect(shape.fExtentRect, combinedExtent, combinedExtent)
                {$Pop}

            ELSE
                combinedExtent := shape.fExtentRect;
            END;
        END;

    BEGIN
    numberOfShapes := 0;
    combinedExtent := gZeroRect;
    EachVirtualShapeDo(UnionizeShapes);
    END;

{--------------------------------------------------------------------------------------------------}
{$S AOpen}

PROCEDURE TPalette.IPalette(itsDocument: TDocument);

    VAR
        itsSize:            VPoint;

    BEGIN
    SetVPt(itsSize, kPaletteWidth, 0);
    IView(itsDocument, NIL, gZeroVPt, itsSize, sizeFixed, sizeSuperView);

    fCurrShape := 0;
    END;

{--------------------------------------------------------------------------------------------------}
{$IFC qTemplateViews}
{$S AOpen}

PROCEDURE TPalette.IRes(itsDocument: TDocument; itsSuperview: TView; VAR itsParams: Ptr); OVERRIDE;

    BEGIN
    INHERITED IRes(itsDocument, itsSuperview, itsParams);

    fCurrShape := 0;
    END;

{$ENDC}

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TPalette.DoHighlightSelection(fromHL, toHL: HLState);

    VAR
        r:                    Rect;

    BEGIN
    IF (fromHL <> toHL) & (fromHL + toHL <> hlOffDim) THEN
        BEGIN
        r := gChoiceArray[fCurrShape];
        UseSelectionColor;
        InvertRect(r);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ASelCommand}

FUNCTION TPalette.DoMouseCommand(VAR theMouse: Point; VAR info: EventInfo;
                                 VAR hysteresis: Point): TCommand;

    VAR
        i:                    INTEGER;

    BEGIN
    DoMouseCommand := NIL;

    i := 0;
    REPEAT
        IF PtInRect(theMouse, gChoiceArray[i]) THEN
            LEAVE;
        i := i + 1;
    UNTIL i > kShapesInPalette;

    IF (i <= kShapesInPalette) & (i <> fCurrShape) THEN
        BEGIN
        IF Focus THEN
            DoHighlightSelection(hlOn, hlOff);
        fCurrShape := i;
        IF Focus THEN
            DoHighlightSelection(hlOff, hlOn);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

FUNCTION TPalette.DoSetCursor(localPoint: Point; cursorRgn: RgnHandle): BOOLEAN; OVERRIDE;

    VAR
        qdExtent:            Rect;

    BEGIN
    SetCursor(arrow);
    GetQDExtent(qdExtent);
    RectRgn(cursorRgn, qdExtent);
    DoSetCursor := TRUE;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TPalette.Draw(area: Rect);

    VAR
        i:                    INTEGER;
        r:                    Rect;

    BEGIN
    PenSize(1, 1);
    MoveTo(fSize.h - 1, 0);
    Line(0, fSize.v);
    FOR i := 0 TO kShapesInPalette DO
        BEGIN
        FrameRect(gChoiceArray[i]);

        IF i = 0 THEN
            BEGIN
            SetRect(r, 14, 12, 30, 28);
            CopyBits(gArwBitMap, thePort^.portBits, gArwBitMap.bounds, r, srcOR, NIL);
            END
        ELSE
            gShapesArray[i].Draw;
        END;

    INHERITED Draw(area);
    END;

{--------------------------------------------------------------------------------------------------}
{$S AFields}

PROCEDURE TPalette.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr;
                          fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TPalette', NIL, bClass);
    DoToField('fCurrShape', @fCurrShape, bInteger);
    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S AOpen}

PROCEDURE TShapeView.IShapeView(itsDocument: TShapeDocument; itsPalette: TPalette;
                                forClipboard: BOOLEAN);

    VAR
        itsLocation:        VPoint;
        itsSize:            VPoint;
        aHandler:            TStdPrintHandler;
        aDocState:            DocState;
        sd:                 SizeDeterminer;

    BEGIN
    fDragging := FALSE;
    fPalette := itsPalette;
    SetVPt(itsSize, kMaxCoord, kMaxCoord);
    IF forClipboard THEN
        sd := sizeVariable
    ELSE
        sd := sizeFillPages;
    IView(itsDocument, NIL, gZeroVPt, itsSize, sd, sd);
    fScroller := NIL;

    fShapeDocument := itsDocument;

    {$IFC FALSE}                                        {!!! Need to handle this}
    IF forClipboard THEN
        fWouldMakePICTScrap := TRUE;
    {$ENDC}

    IF NOT forClipboard THEN
        BEGIN
        New(aHandler);
        FailNil(aHandler);
        aHandler.IStdPrintHandler(itsDocument, SELF, NOT kSquareDots, { does not have square dots }
                                  kFixedSize,            { horizontal page size is fixed }
                                  kFixedSize);            { vertical page size is fixed }
        END;

    fClickPt := gZeroPt;                                {plausible starting value}
    END;

{--------------------------------------------------------------------------------------------------}
{$IFC qTemplateViews}
{$S AOpen}

PROCEDURE TShapeView.IRes(itsDocument: TDocument; itsSuperview: TView;
    VAR itsParams: Ptr); OVERRIDE;

    VAR
        aHandler:            TStdPrintHandler;

    BEGIN
    fDragging := FALSE;
    fScroller := NIL;
    fPalette := NIL;

    INHERITED IRes(itsDocument, itsSuperview, itsParams);

    fShapeDocument := TShapeDocument(itsDocument);

    New(aHandler);
    FailNil(aHandler);
    aHandler.IStdPrintHandler(itsDocument, SELF, NOT kSquareDots, { does not have square dots }
                              kFixedSize,                { horizontal page size is fixed }
                              kFixedSize);                { vertical page size is fixed }

    fClickPt := gZeroPt;                                {plausible starting value}
    END;

{$ENDC}

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TShapeView.CalcMinSize(VAR minSize: VPoint);

    VAR
        aRect:                Rect;
        numberOfShapes:     INTEGER;

    BEGIN
    fShapeDocument.SurveyShapes(FALSE, numberOfShapes, aRect);
    SetVPt(minSize, Max(100, aRect.right), Max(100, aRect.bottom));
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

FUNCTION TShapeView.ContainsClipType(aType: ResType): BOOLEAN;

    BEGIN
    ContainsClipType := (aType = kShapeClipType);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TShapeView.Deselect;

    PROCEDURE DeselShape(shape: TShape);

        BEGIN
        shape.fIsSelected := FALSE;
        END;

    BEGIN
    DoHighlightSelection(hlOn, hlOff);
    fShapeDocument.EachPotentialShapeDo(DeselShape);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TShapeView.DoHighlightSelection(fromHL, toHL: HLState);

    PROCEDURE HiliteShape(shape: TShape);

        BEGIN
        IF shape.fIsSelected & (NOT fDragging) THEN
            shape.Highlight(fromHL, toHL);
        END;

    BEGIN
    fShapeDocument.EachVirtualShapeDo(HiliteShape);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ASelCommand}

FUNCTION TShapeView.DoMenuCommand(aCmdNumber: CmdNumber): TCommand;

    VAR
        recolorCmd:         TRecolorCmd;
        reshadeCmd:         TReshadeCmd;
        shapeCutCopyCommand: TShapeCutCopyCommand;
        shapePasteCommand:    TShapePasteCommand;
        shapeClearCommand:    TShapeClearCommand;
        menu, item:         INTEGER;
        pMCEntry:            MCEntryPtr;
        theColor:            RGBColor;
        pickerPrompt:        StringHandle;

    PROCEDURE SelectIt(aShape: TShape);

        BEGIN
        IF NOT aShape.fIsSelected THEN
            BEGIN
            aShape.fIsSelected := TRUE;
            aShape.Highlight(hlOff, hlOn);
            END;
        END;

    FUNCTION GetShapeColor(aShape: TShape): BOOLEAN;

        BEGIN
        GetShapeColor := TRUE;
        END;

    BEGIN
    DoMenuCommand := NIL;

    CASE aCmdNumber OF

        cWhite, cLtGray, cGray, cDkGray, cBlack:
            BEGIN
            New(reshadeCmd);
            FailNil(reshadeCmd);
            reshadeCmd.IReshadeCmd(aCmdNumber, SELF);
            DoMenuCommand := reshadeCmd;
            END;

        cCut, cCopy:
            BEGIN
            New(shapeCutCopyCommand);
            FailNil(shapeCutCopyCommand);
            shapeCutCopyCommand.IShapeCutCopyCommand(aCmdNumber, SELF);
            DoMenuCommand := shapeCutCopyCommand;
            END;

        cPaste:
            BEGIN
            New(shapePasteCommand);
            FailNil(shapePasteCommand);
            shapePasteCommand.IShapePasteCommand(SELF);
            DoMenuCommand := shapePasteCommand;
            END;

        cClear:
            BEGIN
            New(shapeClearCommand);
            FailNil(shapeClearCommand);
            shapeClearCommand.IShapeClearCommand(SELF);
            DoMenuCommand := shapeClearCommand;
            END;

        {$IFC qDebug}
        cRecalcExtent:
            AdjustSize;
        {$ENDC}

        cSelectAll:
            BEGIN
            IF Focus THEN;                                {At least try to focus}
            fShapeDocument.EachVirtualShapeDo(SelectIt);
            END;

        cPickColor:
            BEGIN
            theColor := fShapeDocument.FirstSelectedShapeThat(GetShapeColor).fColor;
            pickerPrompt := GetString(kPickerPrompt);
            FailNil(pickerPrompt);
            IF GetColor(gZeroPt, pickerPrompt^^, theColor, theColor) THEN
                BEGIN
                New(recolorCmd);
                FailNil(recolorCmd);
                recolorCmd.IRecolorCmd(theColor, SELF);
                DoMenuCommand := recolorCmd;
                END;
            END;

        cBetterFeedback:
            gBetterFeedback := NOT gBetterFeedback;

        OTHERWISE
            BEGIN
            CmdToMenuItem(aCmdNumber, menu, item);
            IF menu = mColor THEN
                BEGIN
                New(recolorCmd);
                FailNil(recolorCmd);
                pMCEntry := GetMCEntry(menu, item);
                theColor := pMCEntry^.mctRGB2;            {the MC entry can move}
                recolorCmd.IRecolorCmd(theColor, SELF);
                DoMenuCommand := recolorCmd;
                END
            ELSE
                DoMenuCommand := INHERITED DoMenuCommand(aCmdNumber);
            END;

    END;                                                {Case}
    END;

{--------------------------------------------------------------------------------------------------}
{$S ASelCommand}

FUNCTION TShapeView.DoMouseCommand(VAR theMouse: Point; VAR info: EventInfo;
                                   VAR hysteresis: Point): TCommand;

    VAR
        palette:            TPalette;
        protoShape:         TShape;
        shapeSketcher:        TShapeSketcher;
        shapeUnderMouse:    TShape;
        shapeSelector:        TShapeSelector;
        shapeDragger:        TShapeDragger;
        fi:                 FailInfo;

    PROCEDURE HdlInitCmdFailed(error: OSErr; message: LONGINT);

        BEGIN
        FreeIfObject(protoShape);
        protoShape := NIL;
        END;

    PROCEDURE CheckShape(aShape: TShape);

        BEGIN
        {$Push} {$h-}
        IF PtInRect(theMouse, aShape.fExtentRect) THEN
            shapeUnderMouse := aShape;
        {$Pop}
        END;

    BEGIN                                                { DoMouseCommand }
    DoMouseCommand := NIL;

    palette := fPalette;
    fClickPt := theMouse;
    IF palette.fCurrShape > 0 THEN                        {draw mode}
        BEGIN
        FailSpaceIsLow;                                 { Make sure we aren't low on memory }

        Deselect;

        {Clone appropriate shape}

        protoShape := TShape(gShapesArray[palette.fCurrShape].Clone);
        FailNil(protoShape);

        CatchFailures(fi, HdlInitCmdFailed);
        { Make sure cloning the shape left us with enough memory to continue.}
        FailSpaceIsLow;

        New(shapeSketcher);
        FailNil(shapeSketcher);
        shapeSketcher.IShapeSketcher(SELF, protoShape, info.theOptionKey);
        Success(fi);
        DoMouseCommand := shapeSketcher;
        END                                             {draw mode}
    ELSE
        BEGIN                                            {select mode}
        shapeUnderMouse := NIL;
        fShapeDocument.EachVirtualShapeDo(CheckShape);

        IF shapeUnderMouse = NIL THEN                    {area select}
            BEGIN
            IF NOT info.theShiftKey THEN
                Deselect;
            New(shapeSelector);
            FailNil(shapeSelector);
            shapeSelector.IShapeSelector(cMouseCommand, SELF);
            DoMouseCommand := shapeSelector;
            END                                         {area select}

        ELSE
            BEGIN                                        {shape select/move/...}

            IF NOT (shapeUnderMouse.fIsSelected | info.theShiftKey) THEN
                Deselect;

            IF info.theShiftKey THEN
                BEGIN
                shapeUnderMouse.fIsSelected := NOT shapeUnderMouse.fIsSelected;
                IF shapeUnderMouse.fIsSelected THEN
                    shapeUnderMouse.Highlight(hlOff, hlOn)
                ELSE
                    shapeUnderMouse.Highlight(hlOn, hlOff);
                END
            ELSE IF NOT shapeUnderMouse.fIsSelected THEN
                BEGIN
                shapeUnderMouse.fIsSelected := TRUE;
                DoHighlightSelection(hlOff, hlOn);
                END;

            IF shapeUnderMouse.fIsSelected THEN
                BEGIN
                New(shapeDragger);
                FailNil(shapeDragger);
                shapeDragger.IShapeDragger(SELF);
                DoMouseCommand := shapeDragger;
                END;
            {ELSE, fall-through, we return NIL}
            END;                                        {shape select/move/...}
        END;                                            {Select mode}
    END;                                                { DoMouseCommand }

{--------------------------------------------------------------------------------------------------}
{$S ARes}

FUNCTION TShapeView.DoSetCursor(localPoint: Point; cursorRgn: RgnHandle): BOOLEAN; OVERRIDE;

    VAR
        cursorSet:            BOOLEAN;
        qdExtent:            Rect;
        shapeExtent:        Rect;

    PROCEDURE TestShape(shape: TShape);

        BEGIN
        {$Push} {$h-}
        IF PtInRect(localPoint, shape.fExtentRect) THEN
        {$Pop}
            BEGIN
            UseROMMap(TRUE);
            SetCursor(GetCursor(plusCursor)^^);
            shapeExtent := shape.fExtentRect;            {RectRgn may move memory}
            RectRgn(cursorRgn, shapeExtent);
            cursorSet := TRUE;

 {can't exit from the middle of an Each, because TList
 doesn't allow it; should really use FirstWhich;
 no harm in skipping the Exit, just takes longer}
            {* Exit(DoSetCursor); *}
            END;
        END;

    BEGIN                                                { DoSetCursor }
    IF fPalette.fCurrShape = 0 THEN                     {selection}
        BEGIN
        cursorSet := FALSE;
        fShapeDocument.EachVirtualShapeDo(TestShape);
        IF NOT cursorSet THEN
            IF qNeedsColorQD | gConfiguration.hasColorQD THEN
            {set cursor to color arrow}
                SetCCursor(gRainbowArrow)
            ELSE
                SetCursor(arrow);
        DoSetCursor := TRUE;
        END
    ELSE
        BEGIN
        DoSetCursor := TRUE;
        UseROMMap(TRUE);
        SetCursor(GetCursor(crossCursor)^^);
        GetQDExtent(qdExtent);
        RectRgn(cursorRgn, qdExtent);
        END;
    END;                                                { DoSetCursor }

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TShapeView.DoSetupMenus;

    VAR
        i:                    INTEGER;
        anySelection:        BOOLEAN;
        anyShapes:            BOOLEAN;
        haveMemory:         BOOLEAN;
        aMenuHandle:        MenuHandle;
        item:                INTEGER;
        itemName:            Str255;

    PROCEDURE TestShapes(theShape: TShape);

        BEGIN
        anySelection := anySelection | theShape.fIsSelected;
        anyShapes := anyShapes | (NOT fShapeDocument.fFiltering) | (NOT theShape.fWasSelected);
        END;

    BEGIN

    INHERITED DoSetupMenus;

    anySelection := FALSE;
    anyShapes := FALSE;

    haveMemory := NOT MemSpaceIsLow;
    { Find out if we are low on memory.  If we are then we'll disable all
      memory-intensive commands. }

    fShapeDocument.EachVirtualShapeDo(TestShapes);
    { This checks every virtual shape--could be made faster. }

    FOR i := cWhite TO cBlack DO
        Enable(i, anySelection);

    IF anySelection & (qNeedsColorQD | gConfiguration.hasColorQD) THEN
        BEGIN
        { Enable each of the Color menu items, if the Color menu is present }
        aMenuHandle := GetMHandle(mColor);
        IF aMenuHandle <> NIL THEN
            FOR item := 1 TO CountMItems(aMenuHandle) DO
                BEGIN
 { There can be more than 31 menu entries with scrolling menus,
   but trying to enable an item with number > 31 is bad news.
   If the menu itself is enabled (which it will be in MacApp
   if any of the first 31 items is enabled), then the extras
   will always be enabled. }
                {Don't enable line separators.}
                GetItem(aMenuHandle, item, itemName);
                IF (item <= 31) & (itemName <> '-') THEN
                    EnableItem(aMenuHandle, item);
                END;
        END;

    {$IFC qDebug}
    Enable(cRecalcExtent, TRUE);
    {$ENDC}
    Enable(cCut, anySelection & haveMemory);
    Enable(cCopy, anySelection & haveMemory);
    IF haveMemory THEN
        CanPaste(kShapeClipType);
    Enable(cClear, anySelection);

    Enable(cSelectAll, anyShapes);
    EnableCheck(cBetterFeedback, TRUE, gBetterFeedback);
    END;                                                { DoSetupMenus }

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TShapeView.Draw(area: Rect);

    PROCEDURE DrawShape(shape: TShape);

        VAR
            r:                    Rect;

        BEGIN
        {$Push} {$h-}
        IF NOT (fDragging & shape.fIsSelected) & SectRect(shape.fExtentRect, area, r) THEN
            shape.Draw;
        {$Pop}
        END;

    BEGIN
    fShapeDocument.EachVirtualShapeDo(DrawShape);        {draw the shapes}

    INHERITED Draw(area);
    END;

{--------------------------------------------------------------------------------------------------}
{$S AFields}

PROCEDURE TShapeView.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr;
                                                fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TShapeView', NIL, bClass);
    DoToField('fDragging', @fDragging, bBoolean);
    DoToField('fPalette', @fPalette, bObject);
    DoToField('fClickPt', @fClickPt, bPoint);
    DoToField('fShapeDocument', @fShapeDocument, bObject);
    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TShapeView.InvalShape(aShape: TShape);

    VAR
        r:                    Rect;

    BEGIN
    r := aShape.fExtentRect;
    InsetRect(r, - 2, - 2);
    InvalidRect(r);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TShapeView.RestoreSelection;

    PROCEDURE DoRestore(aShape: TShape);

        VAR
            wantInval:            BOOLEAN;

        BEGIN
        wantInval := aShape.fIsSelected | aShape.fWasSelected;
        aShape.fIsSelected := aShape.fWasSelected;
        IF wantInval THEN
            InvalShape(aShape);
        END;

    BEGIN
    IF Focus THEN;
    Deselect;
    fShapeDocument.EachPotentialShapeDo(DoRestore);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TShapeView.SaveSelection(andInval: BOOLEAN);

    PROCEDURE DoToShape(aShape: TShape);

        BEGIN
        WITH aShape DO
            fWasSelected := fIsSelected;
        IF andInval & aShape.fWasSelected THEN
            InvalShape(aShape);
        END;

    BEGIN
    IF Focus THEN;
    fShapeDocument.EachPotentialShapeDo(DoToShape);
    END;

{--------------------------------------------------------------------------------------------------}
{$S AClipboard}

PROCEDURE TShapeView.WriteToDeskScrap;

    VAR
        err:                LONGINT;
        clipShapes:         ShapesOnClipboard;
        count:                INTEGER;
        bBox:                Rect;
        i:                    INTEGER;
        outline:            Rect;
        aShapeDatum:        ShapeData;
        wantBytes:            INTEGER;

    PROCEDURE CopyToDeskScrap(aShape: TShape);

        BEGIN
        WITH aShapeDatum DO
            BEGIN
            theId := aShape.id;
            theShade := aShape.fShade;
            theColor := aShape.fColor;
            theRect := aShape.fExtentRect;
            END;
        clipShapes^^.theShapes[i] := aShapeDatum;
        i := i + 1;
        END;

    BEGIN
 { Write the PICT scrap first in case we will be unable to write both
   the PICT scrap and our own scrap type.}
    INHERITED WriteToDeskScrap;                         {Generate PICT-type scrap}

    fShapeDocument.SurveyShapes(FALSE, count, bBox);    {count shapes}
    wantBytes := SIZEOF(INTEGER) + SIZEOF(Rect) + (count * SIZEOF(ShapeData));
    {??? call CanAllocate, and if can't get enough, put up alert?}
    clipShapes := ShapesOnClipboard(NewPermHandle(wantBytes));
    FailNil(clipShapes);

    WITH clipShapes^^ DO
        BEGIN
        theBoundingBox := bBox;
        theNumberOfShapes := count;
        END;
    i := 0;
    fShapeDocument.EachShapeDo(CopyToDeskScrap);
    err := PutDeskScrapData(kShapeClipType, Handle(clipShapes));
    Handle(clipShapes) := DisposeIfHandle(clipShapes);

    FailOSErr(err);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TShape.Initialize; OVERRIDE;

    BEGIN
    INHERITED Initialize;

    fID := 0;
    fExtentRect := gZeroRect;
    fShade := cWhite;
    fColor := gRGBWhite;
    fIsSelected := FALSE;
    fWasSelected := FALSE;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TShape.IShape(itsExtent: Rect; itsID: INTEGER);

    BEGIN
    IObject;
    fExtentRect := itsExtent;
    fID := itsID;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TShape.Draw;

    BEGIN
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TShape.DrawOutline;

    BEGIN
    {$IFC qDebug}
    ProgramBreak('TShape.DrawOutline called!');
    {$ENDC}
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TShape.EachHandleDo(PROCEDURE DoThis(Handle: Rect; handVHS: VHSelect;
                                               handTopOrLeft: BOOLEAN));

    VAR
        r:                    Rect;
        extent:             Rect;

    BEGIN
    SetRect(r, - 2, - 2, 2, 2);
    extent := fExtentRect;

    WITH extent DO
        BEGIN
        OffSetRect(r, left, (top + bottom) DIV 2);
        DoThis(r, h, TRUE);                             {left}

        OffSetRect(r, right - left, 0);
        DoThis(r, h, FALSE);                            {right}

        OffSetRect(r, - (right - left) DIV 2, top - ((top + bottom) DIV 2));
        DoThis(r, v, TRUE);                             {top}

        OffSetRect(r, 0, bottom - top);
        DoThis(r, v, FALSE);                            {bottom}
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AFields}

PROCEDURE TShape.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr;
    fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TShape', NIL, bClass);
    DoToField('fID', @fID, bInteger);
    DoToField('fExtentRect', @fExtentRect, bRect);
    DoToField('fShade', @fShade, bInteger);
    DoToField('fOldShade', @fOldShade, bInteger);
    DoToField('fColor', @fColor, bRGBColor);
    DoToField('fOldColor', @fOldColor, bRGBColor);
    DoToField('fIsSelected', @fIsSelected, bBoolean);
    DoToField('fWasSelected', @fWasSelected, bBoolean);
    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TShape.Highlight(fromHL, toHL: HLState);

{--------------------------------------------------------------------------------------------------}

    PROCEDURE PaintHandle(Handle: Rect; handVHS: VHSelect; handTopOrLeft: BOOLEAN);

        BEGIN
        PaintRect(Handle);
        END;

    BEGIN
    SetHLPenState(fromHL, toHL);
    EachHandleDo(PaintHandle);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

FUNCTION TShape.id: INTEGER;

    BEGIN
    id := fID;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AReadFile}

PROCEDURE TShape.ReadFrom(aRefNum: INTEGER);

    VAR
        data:                ShapeData;
        count:                LONGINT;

    BEGIN
    { DoRead has already read in the id; read the rest of the data }
    count := SIZEOF(ShapeData) - SIZEOF(INTEGER);
    FailOSErr(FSRead(aRefNum, count, @data.theRect));

    WITH data DO
        BEGIN
        fExtentRect := theRect;
        fShade := theShade;
        fColor := theColor;
        fIsSelected := theSelected;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AWriteFile}

PROCEDURE TShape.WriteTo(aRefNum: INTEGER);

    VAR
        data:                ShapeData;
        count:                LONGINT;

    BEGIN
    WITH data DO
        BEGIN
        theId := id;
        theRect := fExtentRect;
        theShade := fShade;
        theColor := fColor;
        theSelected := fIsSelected;
        END;
    count := SIZEOF(ShapeData);
    FailOSErr(FSWrite(aRefNum, count, @data));
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TBox.IBox(itsExtent: Rect; itsID: INTEGER);

    BEGIN
    IShape(itsExtent, itsID);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TBox.Draw;

    VAR
        itsExtent:            Rect;
        itsColor:            RGBColor;

    BEGIN
    PenNormal;
    itsExtent := fExtentRect;

    IF qNeedsColorQD | gConfiguration.hasColorQD THEN
        BEGIN
        {Get the color of the menu item representing the shape's color}
        itsColor := fColor;
        RGBForeColor(itsColor);
        FillRect(itsExtent, gPat[fShade]);
        ForeColor(blackColor);
        END
    ELSE
        FillRect(itsExtent, gPat[fShade]);

    DrawOutline;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TBox.DrawOutline;

    VAR
        itsExtent:            Rect;

    BEGIN
    PenSize(1, 1);
    itsExtent := fExtentRect;                            {FrameRect may move memory.}
    FrameRect(itsExtent);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE THeavyBox.IHeavyBox(itsExtent: Rect; itsID: INTEGER);

    BEGIN
    IBox(itsExtent, itsID);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE THeavyBox.Draw;

    CONST
        s                    = '4K';

    VAR
        itsExtent:            Rect;
        wid:                INTEGER;
        r:                    Rect;
        x:                    INTEGER;

    BEGIN
    INHERITED Draw;

    itsExtent := fExtentRect;

    PenSize(2, 2);
    FrameRect(itsExtent);

    TextFont(geneva);
    TextFace([]);
    TextSize(9);
    TextMode(srcOR);

    wid := StringWidth(s);

    WITH itsExtent DO
        x := (left + right) DIV 2;

    SetRect(r, x - 7, itsExtent.bottom - 14, x + 7, itsExtent.bottom - 4);
    EraseRect(r);
    MADrawString(AtStr(s), r, teJustCenter);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TCircle.ICircle(itsExtent: Rect; itsID: INTEGER);

    BEGIN
    IShape(itsExtent, itsID);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TCircle.Draw;

    VAR
        itsExtent:            Rect;
        itsColor:            RGBColor;

    BEGIN
    PenNormal;
    itsExtent := fExtentRect;                            {FillOval may move memory}

    IF qNeedsColorQD | gConfiguration.hasColorQD THEN
        BEGIN
        {Get the color of the menu item representing the shape's color}
        itsColor := fColor;
        RGBForeColor(itsColor);
        FillOval(itsExtent, gPat[fShade]);
        ForeColor(blackColor);
        END
    ELSE
        FillOval(itsExtent, gPat[fShade]);

    DrawOutline;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TCircle.DrawOutline;

    VAR
        itsExtent:            Rect;

    BEGIN
    PenSize(1, 1);
    itsExtent := fExtentRect;                            {FrameOval may move memory}
    FrameOval(itsExtent);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ASelCommand}

PROCEDURE TShapeCommand.IShapeCommand(itsCmdNumber: CmdNumber; itsShapeView: TShapeView;
                                      betterFeedbackDesired: BOOLEAN);

    BEGIN
    IBetterFeedbackCmd(itsCmdNumber, itsShapeView.fShapeDocument, itsShapeView,
                       itsShapeView.fScroller, betterFeedbackDesired);
    fShapeView := itsShapeView;
    fShapeDocument := itsShapeView.fShapeDocument;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AFields}

PROCEDURE TShapeCommand.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr;
                                                   fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TShapeCommand', NIL, bClass);
    DoToField('fShapeView', @fShapeView, bObject);
    DoToField('fShapeDocument', @fShapeDocument, bObject);
    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ASelCommand}

PROCEDURE TShapeSelector.IShapeSelector(itsCmdNumber: CmdNumber; itsShapeView: TShapeView);

    BEGIN
    IShapeCommand(itsCmdNumber, itsShapeView, gBetterFeedback);
    fCausesChange := FALSE;
    fCanUndo := FALSE;
    fBounds := gZeroRect;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TShapeSelector.DoIt; OVERRIDE;

    VAR
        shapeView:            TShapeView;

    PROCEDURE TestShape(shape: TShape);

        BEGIN
        {$Push} {$h-}
        IF RectsNest(fBounds, shape.fExtentRect) THEN
        {$Pop}
            BEGIN
            IF shape.fIsSelected THEN
                shape.Highlight(hlOn, hlOff)
            ELSE
                shape.Highlight(hlOff, hlOn);
            shape.fIsSelected := NOT shape.fIsSelected;
            END;
        END;

    BEGIN
    shapeView := fShapeView;
    shapeView.fShapeDocument.EachVirtualShapeDo(TestShape);
    END;

{--------------------------------------------------------------------------------------------------}
{$S AFields}

PROCEDURE TShapeSelector.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr;
                                                    fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TShapeSelector', NIL, bClass);
    DoToField('fBounds', @fBounds, bRect);
    DoToField('fShiftKey', @fShiftKey, bBoolean);
    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TShapeSelector.TrackFeedback(anchorPoint, nextPoint: VPoint; turnItOn,
                                       mouseDidMove: BOOLEAN);

    VAR
        r:                    Rect;

    BEGIN
    INHERITED TrackFeedback(anchorPoint, nextPoint, turnItOn, mouseDidMove);
    IF (fView <> NIL) & mouseDidMove THEN
        BEGIN

        PenPat(Gray);
        Pt2Rect(fView.ViewToQDPt(anchorPoint), fView.ViewToQDPt(nextPoint), r);
        FrameRect(r);                                    { draw/erase }

        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

FUNCTION TShapeSelector.TrackMouse(aTrackPhase: TrackPhase; VAR anchorPoint, previousPoint,
                                   nextPoint: VPoint; mouseDidMove: BOOLEAN): TCommand;

    VAR
        r:                    Rect;
        qdAnchor, qdPrevious: Point;

    BEGIN
    TrackMouse := INHERITED TrackMouse(aTrackPhase, anchorPoint, previousPoint, nextPoint,
                                       mouseDidMove);
    qdAnchor := fShapeView.ViewToQDPt(anchorPoint);
    qdPrevious := fShapeView.ViewToQDPt(previousPoint);
    Pt2Rect(qdAnchor, qdPrevious, r);
    fBounds := r;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ASelCommand}

PROCEDURE TShapeDragger.IShapeDragger(aShapeView: TShapeView);

    VAR
        bounds:             Rect;
        numberOfShapes:     INTEGER;

    BEGIN
    IShapeCommand(cMoveShape, aShapeView, gBetterFeedback);

    aShapeView.fShapeDocument.SurveyShapes(TRUE, numberOfShapes, bounds);
    aShapeView.fDragging := FALSE;
    fBounds := bounds;

    fConstrainsMouse := gConstrainDrags;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TShapeDragger.DoIt;

    BEGIN
    MoveBy(fDeltaH, fDeltaV);
    END;

{--------------------------------------------------------------------------------------------------}
{$S AFields}

PROCEDURE TShapeDragger.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr;
                                                   fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TShapeDragger', NIL, bClass);
    DoToField('fBounds', @fBounds, bRect);
    DoToField('fDeltaH', @fDeltaH, bInteger);
    DoToField('fDeltaV', @fDeltaV, bInteger);
    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TShapeDragger.MoveBy(deltaH, deltaV: INTEGER);

    PROCEDURE MoveShape(shape: TShape);

        BEGIN
        IF shape.fIsSelected THEN
            BEGIN
            {$Push} {$h-}
            OffSetRect(shape.fExtentRect, deltaH, deltaV);
            {$Pop}
            fShapeView.InvalShape(shape);
            END;
        shape.fWasSelected := shape.fIsSelected;
        END;

    BEGIN
    IF fShapeView.Focus THEN;
    fShapeDocument.EachShapeDo(MoveShape);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TShapeDragger.RedoIt;

    BEGIN
    fShapeView.RestoreSelection;

    MoveBy(fDeltaH, fDeltaV);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TShapeDragger.TrackConstrain(anchorPoint, previousPoint: VPoint;
    VAR nextPoint: VPoint); OVERRIDE;

    VAR
        vhs:                VHSelect;
        temp:                INTEGER;

    BEGIN
    FOR vhs := v TO h DO
        BEGIN
        temp := anchorPoint.vh[vhs] - fBounds.topLeft.vh[vhs];
        nextPoint.vh[vhs] := Max(temp, nextPoint.vh[vhs]);

        temp := fShapeView.fSize.vh[vhs] - (fBounds.botRight.vh[vhs] - anchorPoint.vh[vhs]);
        nextPoint.vh[vhs] := Min(temp, nextPoint.vh[vhs]);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TShapeDragger.TrackFeedback(anchorPoint, nextPoint: VPoint; turnItOn,
                                      mouseDidMove: BOOLEAN);

    VAR
        aRect:                Rect;
        delta:                Point;

    BEGIN
    INHERITED TrackFeedback(anchorPoint, nextPoint, turnItOn, mouseDidMove);
    IF mouseDidMove & fShapeView.fDragging THEN
        BEGIN
        delta.h := nextPoint.h - anchorPoint.h;
        delta.v := nextPoint.v - anchorPoint.v;

        aRect := fBounds;
        OffSetRect(aRect, delta.h, delta.v);

        FrameRect(aRect);                                { draw/erase it }
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

FUNCTION TShapeDragger.TrackMouse(aTrackPhase: TrackPhase; VAR anchorPoint, previousPoint,
                                  nextPoint: VPoint; mouseDidMove: BOOLEAN): TCommand;

    PROCEDURE EraseShape(shape: TShape);

        VAR
            r:                    Rect;

        BEGIN
        IF shape.fIsSelected THEN
            fShapeView.InvalShape(shape);
        END;

    BEGIN
    TrackMouse := INHERITED TrackMouse(aTrackPhase, anchorPoint, previousPoint, nextPoint,
                                       mouseDidMove);

    IF aTrackPhase = trackRelease THEN                    {set up for moving the shape(s)}
        BEGIN
        IF fShapeView.fDragging THEN                    {actually did move}
            BEGIN
            fDeltaH := previousPoint.h - anchorPoint.h;
            fDeltaV := previousPoint.v - anchorPoint.v;

            fShapeView.fDragging := FALSE;
            END
        ELSE
            TrackMouse := NIL;
        END

    ELSE IF aTrackPhase = trackMove THEN
        IF mouseDidMove THEN
            IF NOT fShapeView.fDragging THEN            {this is first move}
                BEGIN
                fShapeView.DoHighlightSelection(hlOn, hlOff);
                fShapeDocument.EachVirtualShapeDo(EraseShape);
                fShapeView.fDragging := TRUE;
                fShapeView.GetWindow.Update;
                IF fShapeView.Focus THEN;                {UpdateEvent changes the focus - restore it}
                END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TShapeDragger.UndoIt;

    BEGIN
    fShapeView.RestoreSelection;

    MoveBy( - fDeltaH, - fDeltaV);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ASelCommand}

PROCEDURE TReshadeCmd.IReshadeCmd(itsCmdNumber: INTEGER; itsShapeView: TShapeView);

    BEGIN
    IShapeCommand(cChangeShade, itsShapeView, NOT kBetterFeedbackDesired);
    fShade := itsCmdNumber;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TReshadeCmd.DoIt;

    PROCEDURE ReshadeShape(shape: TShape);

        VAR
            menu, item:         INTEGER;

        BEGIN
        IF shape.fIsSelected THEN
            BEGIN
            shape.fOldShade := shape.fShade;
            shape.fShade := fShade;
            fShapeView.InvalShape(shape);
            END;
        shape.fWasSelected := shape.fIsSelected;
        END;

    BEGIN
    IF fShapeView.Focus THEN;
    fShapeDocument.EachShapeDo(ReshadeShape);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TReshadeCmd.RedoIt;

    PROCEDURE ReshadeShape(shape: TShape);

        VAR
            r:                    Rect;
            menu, item:         INTEGER;

        BEGIN
        IF shape.fWasSelected THEN
            BEGIN
            shape.fOldShade := shape.fShade;
            shape.fShade := fShade;
            fShapeView.InvalShape(shape);
            END;
        shape.fIsSelected := shape.fWasSelected;
        END;

    BEGIN
    IF fShapeView.Focus THEN;
    fShapeView.Deselect;
    fShapeDocument.EachShapeDo(ReshadeShape);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TReshadeCmd.UndoIt;

    PROCEDURE ReshadeShape(shape: TShape);

        VAR
            r:                    Rect;

        BEGIN
        IF shape.fWasSelected THEN
            BEGIN
            shape.fShade := shape.fOldShade;
            fShapeView.InvalShape(shape);
            END;
        shape.fIsSelected := shape.fWasSelected;
        END;

    BEGIN
    IF fShapeView.Focus THEN;
    fShapeView.Deselect;
    fShapeDocument.EachShapeDo(ReshadeShape);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ASelCommand}

PROCEDURE TRecolorCmd.IRecolorCmd(itsColor: RGBColor; itsShapeView: TShapeView);

    BEGIN
    IShapeCommand(cChangeColor, itsShapeView, NOT kBetterFeedbackDesired);
    fColor := itsColor;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TRecolorCmd.DoIt;

    PROCEDURE RecolorShape(shape: TShape);

        VAR
            menu, item:         INTEGER;

        BEGIN
        IF shape.fIsSelected THEN
            BEGIN
            shape.fOldColor := shape.fColor;
            shape.fColor := fColor;
            fShapeView.InvalShape(shape);
            END;
        shape.fWasSelected := shape.fIsSelected;
        END;

    BEGIN
    IF fShapeView.Focus THEN;
    fShapeDocument.EachShapeDo(RecolorShape);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TRecolorCmd.RedoIt;

    PROCEDURE RecolorShape(shape: TShape);

        VAR
            r:                    Rect;
            menu, item:         INTEGER;

        BEGIN
        IF shape.fWasSelected THEN
            BEGIN
            shape.fOldColor := shape.fColor;
            shape.fColor := fColor;
            fShapeView.InvalShape(shape);
            END;
        shape.fIsSelected := shape.fWasSelected;
        END;

    BEGIN
    IF fShapeView.Focus THEN;
    fShapeView.Deselect;
    fShapeDocument.EachShapeDo(RecolorShape);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TRecolorCmd.UndoIt;

    PROCEDURE RecolorShape(shape: TShape);

        VAR
            r:                    Rect;

        BEGIN
        IF shape.fWasSelected THEN
            BEGIN
            shape.fColor := shape.fOldColor;
            fShapeView.InvalShape(shape);
            END;
        shape.fIsSelected := shape.fWasSelected;
        END;

    BEGIN
    IF fShapeView.Focus THEN;
    fShapeView.Deselect;
    fShapeDocument.EachShapeDo(RecolorShape);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TShapeReplaceCommand.Commit; OVERRIDE;

    PROCEDURE HandleIt(aShape: TShape);

        BEGIN
        IF aShape.fWasSelected THEN
            fShapeDocument.DeleteShape(aShape);
        END;

    BEGIN
    IF fShapeDocument.fFiltering THEN
        fShapeDocument.EachShapeDo(HandleIt);
    fShapeDocument.fFiltering := FALSE;
    fShapeDocument.fReplaceCommand := NIL;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TShapeReplaceCommand.EachNewShapeDo(PROCEDURE
                                              DoThis(shape: TShape));

    BEGIN
    END;

{--------------------------------------------------------------------------------------------------}
{$ARes}

FUNCTION TShapeReplaceCommand.FirstShapeThat(FUNCTION
                                             TestShape(aShape: TShape): BOOLEAN): TShape;

    BEGIN
    FirstShapeThat := NIL;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TShapeReplaceCommand.RedoIt; OVERRIDE;

    BEGIN
    IF fShapeDocument.fFiltering THEN
        fShapeView.RestoreSelection;
    fShapeDocument.fReplaceCommand := SELF;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TShapeReplaceCommand.UndoIt; OVERRIDE;

    BEGIN
    fShapeView.RestoreSelection;
    fShapeDocument.fReplaceCommand := NIL;
    fShapeDocument.fFiltering := FALSE;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ASelCommand}

PROCEDURE TShapeSketcher.IShapeSketcher(aShapeView: TShapeView; protoShape: TShape;
                                        constrain: BOOLEAN);

    BEGIN
    IShapeCommand(cNewShape, aShapeView, gBetterFeedback);
    fShape := protoShape;
    fConstrainsMouse := constrain;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TShapeSketcher.Free;

    BEGIN
    FreeIfObject(fShape);
    fShape := NIL;

    INHERITED Free;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TShapeSketcher.DoIt;

    VAR
        pMCEntry:            MCEntryPtr;

    BEGIN
    fShape.fIsSelected := TRUE;
    fShape.fShade := cShadeBase + ABS(Random MOD kNoOfShades);
    IF qNeedsColorQD | gConfiguration.hasColorQD THEN
    { Pick a random color from the Color menu }
        BEGIN
        pMCEntry := GetMCEntry(mColor, ABS(Random MOD CountMItems(GetMHandle(mColor))) + 1);
        fShape.fColor := pMCEntry^.mctRGB2;
        END
    ELSE
        fShape.fColor := gRGBBlack;                     { Set color to black }

    fShapeDocument.fReplaceCommand := SELF;
    fShapeView.InvalShape(fShape);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TShapeSketcher.UndoIt;

    BEGIN
    INHERITED UndoIt;
    fShapeView.InvalShape(fShape);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TShapeSketcher.RedoIt;

    BEGIN
    IF fShapeView.Focus THEN;
    fShapeView.Deselect;
    INHERITED RedoIt;
    fShape.fIsSelected := TRUE;
    fShapeView.InvalShape(fShape);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TShapeSketcher.Commit;

    BEGIN
    fShapeDocument.AddShape(fShape);                    { Add the shape to the list }
    { Set this field to NIL to prevent Free from freeing it}
    fShape := NIL;
    INHERITED Commit;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TShapeSketcher.EachNewShapeDo(PROCEDURE DoThis(shape: TShape)); OVERRIDE;

    BEGIN
    DoThis(fShape);                                     { there's only one shape }
    END;

{--------------------------------------------------------------------------------------------------}
{$ARes}

FUNCTION TShapeSketcher.FirstShapeThat(FUNCTION TestShape(aShape: TShape): BOOLEAN): TShape;
    OVERRIDE;

    BEGIN
    IF TestShape(fShape) THEN                            { there's only one shape to test }
        FirstShapeThat := fShape
    ELSE
        FirstShapeThat := NIL;
    END;

{--------------------------------------------------------------------------------------------------}
{$S AFields}

PROCEDURE TShapeSketcher.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr;
                                                    fieldType: INTEGER)); OVERRIDE;

    BEGIN
    DoToField('TShapeSketcher', NIL, bClass);
    DoToField('fShape', @fShape, bRect);
    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TShapeSketcher.TrackConstrain(anchorPoint, previousPoint: VPoint;
    VAR nextPoint: VPoint); OVERRIDE;

    VAR
        dh:                 INTEGER;
        dv:                 INTEGER;
        absDh:                INTEGER;
        absDv:                INTEGER;
        delta:                INTEGER;

    BEGIN
    dh := nextPoint.h - anchorPoint.h;
    dv := nextPoint.v - anchorPoint.v;
    absDh := ABS(dh);
    absDv := ABS(dv);
    delta := Min(absDh, absDv);
    IF dh < 0 THEN
        dh := - delta
    ELSE
        dh := delta;
    IF dv < 0 THEN
        dv := - delta
    ELSE
        dv := delta;
    nextPoint.h := anchorPoint.h + dh;
    nextPoint.v := anchorPoint.v + dv;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TShapeSketcher.TrackFeedback(anchorPoint, nextPoint: VPoint; turnItOn,
                                       mouseDidMove: BOOLEAN);

    BEGIN
    INHERITED TrackFeedback(anchorPoint, nextPoint, turnItOn, mouseDidMove);
    IF mouseDidMove & (fShape <> NIL) THEN
        fShape.DrawOutline;                             { draw/erase }
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

FUNCTION TShapeSketcher.TrackMouse(aTrackPhase: TrackPhase; VAR anchorPoint, previousPoint,
                                   nextPoint: VPoint; mouseDidMove: BOOLEAN): TCommand;

    VAR
        aVRect:             VRect;
        r:                    Rect;
        size:                Point;
        bigEnough:            BOOLEAN;

    BEGIN
    TrackMouse := INHERITED TrackMouse(aTrackPhase, anchorPoint, previousPoint, nextPoint,
                                       mouseDidMove);

    IF aTrackPhase = trackRelease THEN                    {create the new shape}
        BEGIN
        bigEnough := FALSE;

        size.h := nextPoint.h - anchorPoint.h;
        size.v := nextPoint.v - anchorPoint.v;
        IF ABS(size.h) >= kMinWidth THEN
            IF ABS(size.v) >= kMinHeight THEN
                bigEnough := TRUE;

        IF NOT bigEnough THEN
            BEGIN
            FreeIfObject(fShape);
            fShape := NIL;

            TrackMouse := NIL;
            END;
        END
    ELSE
        BEGIN
        Pt2VRect(anchorPoint, nextPoint, aVRect);
        VRectToRect(aVRect, r);                         { okay because we know the view's size is in
                                                         QD dimensions }
        fShape.fExtentRect := r;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ASelCommand}

PROCEDURE TShapeCutCopyCommand.IShapeCutCopyCommand(itsCmdNumber: CmdNumber;
                                                    itsShapeView: TShapeView);

    BEGIN
    IShapeCommand(itsCmdNumber, itsShapeView, NOT kBetterFeedbackDesired);
    fChangesClipboard := TRUE;
    fCausesChange := itsCmdNumber = cCut;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TShapeCutCopyCommand.DoIt;

    VAR
        succeeded:            BOOLEAN;
        clipShapeView:        TShapeView;
        clipDoc:            TShapeDocument;
        selTopLeft:         Point;
        count:                INTEGER;
        outline:            Rect;
        fi:                 FailInfo;

{--------------------------------------------------------------------------------------------------}

    PROCEDURE CopyToClip(shape: TShape);

        VAR
            aNewShape:            TShape;
            r:                    Rect;

        BEGIN
        IF shape.fIsSelected THEN
            BEGIN
            aNewShape := TShape(shape.Clone);
            FailNil(aNewShape);
            WITH aNewShape DO
                BEGIN
                fIsSelected := FALSE;
                fWasSelected := FALSE;
                END;
            r := aNewShape.fExtentRect;
            OffSetRect(r, gClipMargin.h - outline.left, gClipMargin.v - outline.top);
            aNewShape.fExtentRect := r;

            clipDoc.AddShape(aNewShape);
            END;
        END;

    PROCEDURE HdlFailure(error: OSErr; message: LONGINT);

        BEGIN
        FreeIfObject(clipDoc);
        clipDoc := NIL;
        END;

    BEGIN                                                { TShapeCutCopyCommand.DoIt }
    fShapeView.SaveSelection(fCmdNumber = cCut);        {don't inval if it's just COPY}
    New(clipDoc);
    FailNil(clipDoc);
    clipDoc.IShapeDocument(kDocType);

    CatchFailures(fi, HdlFailure);
    fShapeDocument.SurveyShapes(TRUE, count, outline);

    New(clipShapeView);
    FailNil(clipShapeView);
    clipShapeView.IShapeView(clipDoc, NIL, TRUE);

    { Set fShapeView since the doc will NOT be told to DoMakeViews }
    clipDoc.fShapeView := clipShapeView;

    IF fCmdNumber = cCut THEN
        IF fShapeView.Focus THEN;

    fShapeDocument.EachShapeDo(CopyToClip);
    clipShapeView.AdjustSize;

    { Make sure the Cut left us with enough memory to continue. }
    FailSpaceIsLow;
    Success(fi);

    gApplication.ClaimClipboard(clipShapeView);

    fShapeDocument.fFiltering := (fCmdNumber <> cCopy);

    fShapeDocument.fReplaceCommand := SELF;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TShapeCutCopyCommand.RedoIt;

    BEGIN
    fShapeDocument.fFiltering := (fCmdNumber <> cCopy);
    INHERITED RedoIt;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ASelCommand}

PROCEDURE TShapePasteCommand.IShapePasteCommand(itsShapeView: TShapeView);

    VAR
        fi:                 FailInfo;

    PROCEDURE HdlFailure(error: OSErr; message: LONGINT);

        BEGIN
        FreeIfObject(SELF);
        END;

    BEGIN
    fPasteList := NIL;                                    { So free works when we can't allocated it }
    IShapeCommand(cPaste, itsShapeView, NOT kBetterFeedbackDesired);
    CatchFailures(fi, HdlFailure);
    fPasteList := NewList;
    Success(fi);
    {$IFC qDebug}
    fPasteList.SetEltType('TShape');
    {$ENDC}
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TShapePasteCommand.Commit; OVERRIDE;

    VAR
        theShape:            TShape;

    BEGIN
    IF gPasteReplacesSelection THEN
        INHERITED Commit;                                {Deletes old selectees from the document}

 { The following loop transfers shapes from fPasteList to the document's
   shape list, in such a way that fPasteList is shrunk while the
   document's shape list is grown.  This helps prevent running out
   of memory when committing a Paste command. }
    theShape := TShape(fPasteList.First);
    WHILE theShape <> NIL DO
        BEGIN
        fPasteList.Delete(theShape);
        fShapeDocument.AddShape(theShape);
        theShape := TShape(fPasteList.First);
        END;

    fShapeDocument.fReplaceCommand := NIL;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TShapePasteCommand.DoIt; OVERRIDE;

    VAR
        whereToPaste:        Point;
        noOfShapes:         INTEGER;
        translation:        VPoint;
        t:                    INTEGER;
        vhs:                VHSelect;
        extent:             Rect;
        scrollerExtent:     VRect;

    PROCEDURE PasteShape(clipShape: TShape);

        VAR
            aShape:             TShape;

        BEGIN
        aShape := TShape(clipShape.Clone);
        FailNil(aShape);
        WITH aShape DO
            BEGIN
            fIsSelected := TRUE;
            fWasSelected := TRUE;
            {$Push} {$h-}
            OffSetRect(fExtentRect, whereToPaste.h, whereToPaste.v);
            {$Pop}
            END;
        fPasteList.InsertLast(aShape);
        fShapeView.InvalShape(aShape);
        END;

    BEGIN
    {$IFC qDebug}
    IF NOT Member(gClipView, TShapeView) THEN
        ProgramBreak('Attempt to paste a non-TShapeView clipboard');
    {$ENDC}

 { The next section figures out where the pasted shapes should be placed
   in the view. Lovely, isn't it? }
    IF gPasteReplacesSelection THEN
        BEGIN
        { If we're replacing shapes, then paste the new shapes starting at
          the top-left corner of the replaced shapes. Otherwise, start
          at the last clicked point in the view }
        fShapeDocument.SurveyShapes(TRUE, noOfShapes, extent);
        IF noOfShapes > 0 THEN
            whereToPaste := extent.topLeft
        ELSE
            whereToPaste := fShapeView.fClickPt;
        END
    ELSE
        BEGIN
        fShapeView.fSuperView.GetExtent(scrollerExtent);
        FOR vhs := v TO h DO
            WITH scrollerExtent.topLeft DO
                BEGIN
                { temp var "t" needed because Code Generator finds the
                  following expression too complex }
                t := (scrollerExtent.botRight.vh[vhs] + {scrollerExtent.} vh[vhs] -
                     gClipView.fSize.vh[vhs]) DIV 2;
                whereToPaste.vh[vhs] := Max(            {translation.} vh[vhs], t);
                END;
        END;
    SubPt(gClipMargin, whereToPaste);

    fShapeView.SaveSelection(gPasteReplacesSelection);
    fShapeView.Deselect;

    TShapeView(gClipView).fShapeDocument.EachShapeDo(PasteShape);

    fShapeDocument.fFiltering := gPasteReplacesSelection;
    fShapeDocument.fReplaceCommand := SELF;
    fShapeView.AdjustSize;                                {Make sure all the Pasted shapes can be
                                                         seen}
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TShapePasteCommand.Free; OVERRIDE;

    BEGIN
    fPasteList := FreeListIfObject(fPasteList);         {Free the TList object itself}

    INHERITED Free;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TShapePasteCommand.EachNewShapeDo(PROCEDURE
                                            DoThis(shape: TShape));

    BEGIN
    fPasteList.Each(DoThis);
    END;

{--------------------------------------------------------------------------------------------------}
{$ARes}

FUNCTION TShapePasteCommand.FirstShapeThat(FUNCTION
                                           TestShape(aShape: TShape): BOOLEAN): TShape;

    BEGIN
    FirstShapeThat := TShape(fPasteList.FirstThat(TestShape));
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TShapePasteCommand.UndoIt; OVERRIDE;

{--------------------------------------------------------------------------------------------------}

    PROCEDURE BeInvalidated(theShape: TShape);

        BEGIN
        fShapeView.InvalShape(theShape);
        END;

    BEGIN
    INHERITED UndoIt;
    EachNewShapeDo(BeInvalidated);
    IF fShapeView.Focus THEN;
    fShapeDocument.fFiltering := FALSE;
    fShapeView.AdjustSize;                                {In case we replaced shapes when we Pasted}
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TShapePasteCommand.RedoIt; OVERRIDE;

    PROCEDURE BeSelected(shape: TShape);

        BEGIN
        shape.fIsSelected := TRUE;
        fShapeView.InvalShape(shape);
        END;

    BEGIN
    IF fShapeView.Focus THEN;
    fShapeView.Deselect;
    EachNewShapeDo(BeSelected);                         {Invalidate all the newly-added shapes}
    fShapeDocument.fFiltering := gPasteReplacesSelection;
    INHERITED RedoIt;
    fShapeView.AdjustSize;                                {Make sure size reflects the Paste}
    END;

{--------------------------------------------------------------------------------------------------}
{$S ASelCommand}

PROCEDURE TShapeClearCommand.IShapeClearCommand(itsShapeView: TShapeView);

    BEGIN
    IShapeCommand(cClear, itsShapeView, NOT kBetterFeedbackDesired);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TShapeClearCommand.DoIt;

    BEGIN
    fShapeView.SaveSelection(TRUE);                     {TRUE means invalidate the shapes}
    fShapeDocument.fFiltering := TRUE;
    fShapeDocument.fReplaceCommand := SELF;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ADoCommand}

PROCEDURE TShapeClearCommand.RedoIt;

    BEGIN
    fShapeDocument.fFiltering := TRUE;
    INHERITED RedoIt;
    END;

{--------------------------------------------------------------------------------------------------}
{--------------------------------------------------------------------------------------------------}
{--------------------------------------------------------------------------------------------------}

{--------------------------------------------------------------------------------------------------}
{$S AInit}

PROCEDURE TShadeMenu.IShadeMenu;

    VAR
        i, j:                INTEGER;
        r:                    Rect;
        ChoiceID:            INTEGER;

    BEGIN
    IMenu(kShadesMenu                                    {resource ID} , kWShadeChoice + 2,
          kShadeTop + kHShadeChoice + 2);

    { Create the rectangles that hold the shades}
    SetRect(r, kShadeLeft, kShadeTop, kWShadeCell + kShadeLeft, kHShadeCell + kShadeTop);

    ChoiceID := 1;
    {Set the Shade choice rectangles that we can select from}
    FOR i := 1 TO kShadesDown DO
        BEGIN
        FOR j := 1 TO kShadesAcross DO                    {all the rectangles across}
            BEGIN
            fChoiceArray[ChoiceID] := r;
            OffSetRect(r, kWShadeCell + kWCellSpace, 0);
            ChoiceID := ChoiceID + 1;
            END;
        { move rectangle down one row }
        SetRect(r, kShadeLeft, r.bottom + kHCellSpace, kWShadeCell + kShadeLeft, r.bottom +
                kHShadeCell + kHCellSpace);
        END;

    { For this simple example, hard code in the command number to correspond to
      menu position. }
    fShadeCommands[1] := - cWhite;
    fShadeCommands[2] := - cLtGray;
    fShadeCommands[3] := - cGray;
    fShadeCommands[4] := - cDkGray;
    fShadeCommands[5] := - cBlack;
    fShadeCommands[6] := kNoMenuItem;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TShadeMenu.Draw(area: Rect);

    VAR
        i:                    INTEGER;
        r:                    Rect;
        theMenuColors:        MenuColors;

    BEGIN
    { Use the choice array we created to draw the shades (or custom labels) in.}
    FOR i := 1 TO Min(kShadesDown * kShadesAcross, kNoOfShades) DO
        BEGIN

        { set the correct colors for the item }
        GetMenuColors(fMenuHandle^^.menuID, i, theMenuColors);
        SetIfColor(theMenuColors.itemColor);
        SetIfBkColor(theMenuColors.backGroundColor);

        r := fChoiceArray[i];
        FrameRect(r);
        InsetRect(r, 2, 2);
        FillRect(r, gPat[cShadeBase + (i - 1)]);
        END;

    INHERITED Draw(area);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

FUNCTION TShadeMenu.FindItem(hitPt: Point): INTEGER; OVERRIDE;

    VAR
        i:                    INTEGER;
        r:                    Rect;

    BEGIN
    FindItem := kNoMenuItem;                            { return noSelection Made as default }
    FOR i := 1 TO kShadesDown * kShadesAcross DO
        BEGIN
        r := fChoiceArray[i];
        IF PtInRect(hitPt, r) THEN
            BEGIN
            FindItem := fShadeCommands[i];
            LEAVE;
            END;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

PROCEDURE TShadeMenu.Highlight(whichItem: INTEGER; turnItOn: BOOLEAN);

    VAR
        i:                    INTEGER;
        r:                    Rect;
        theMenuColors:        MenuColors;

    BEGIN
    FOR i := 1 TO kShadesDown * kShadesAcross DO
        BEGIN
        IF fShadeCommands[i] = whichItem THEN
            BEGIN
            r := fChoiceArray[i];

            { set the correct colors for the item }
            GetMenuColors(fMenuHandle^^.menuID, i, theMenuColors);
            SetIfColor(theMenuColors.itemColor);
            SetIfBkColor(theMenuColors.backGroundColor);

            { Normal hilight by reversing foreground and background. and redrawing.
            See IM-V pp. 235-236

            In this case the user is choosing a pattern so it is better to just
            frame the pattern }

            IF NOT turnItOn THEN
                BEGIN
                SetIfBkColor(theMenuColors.itemColor);
                SetIfColor(theMenuColors.backGroundColor);
                END
            ELSE
                BEGIN
                SetIfColor(theMenuColors.itemColor);
                SetIfBkColor(theMenuColors.backGroundColor);
                END;

            InsetRect(r, - 1, - 1);
            FrameRect(r);
            InsetRect(r, 2, 2);
            FrameRect(r);
            LEAVE;
            END;
        END;
    END;